home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #051 (1990)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #051 (1990)(Amiga User Group Deutschland e.V.).adf / Pyramide / Pyramide (.txt) < prev    next >
AmigaBASIC Source Code  |  1989-07-02  |  20KB  |  855 lines
  1. acbmname$="spielbild"
  2. REM IF FRE(1)<30000& THEN CLEAR,,30000&                         
  3. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  4. DECLARE FUNCTION xOpen&  LIBRARY
  5. DECLARE FUNCTION xRead&  LIBRARY
  6. DECLARE FUNCTION xWrite& LIBRARY
  7. DECLARE FUNCTION AllocMem&() LIBRARY
  8. LIBRARY "dos.library"
  9. LIBRARY "exec.library"
  10. LIBRARY "graphics.library"
  11.  
  12. loadError$ = ""
  13. GOSUB LoadACBM
  14. IF loadError$ <> "" THEN GOTO Mcleanup
  15.  IF foundCCRT AND ccrtDir% THEN
  16.    FOR kk = 0 TO nColors% -1
  17.       cTabSave%(kk) = PEEKW(colorTab&+(kk*2))   
  18.       cTabWork%(kk) = cTabSave%(kk)
  19.    NEXT
  20.     FOR kk = 0 TO 80
  21.       IF ccrtDir% = 1 THEN
  22.          GOSUB Fcycle
  23.       ELSE   
  24.          GOSUB Bcycle
  25.       END IF
  26.       CALL LoadRGB4&(sViewPort&,VARPTR(cTabWork%(0)),nColors%)
  27.       FOR de1 = 0 TO ccrtSecs& * 3000
  28.          FOR de2 = 0 TO ccrtMics& / 500
  29.          NEXT
  30.       NEXT
  31.    NEXT
  32.     CALL LoadRGB4&(sViewPort&,VARPTR(cTabSave%(0)),nColors%)
  33. END IF
  34.  
  35. Mcleanup:
  36. GOTO spielanfang: 
  37.  
  38. Mcleanup2:
  39. REM LIBRARY CLOSE
  40. IF loadError$ <> "" THEN PRINT loadError$
  41. END
  42. cTemp% = cTabWork%(ccrtEnd%)
  43. FOR jj = ccrtEnd%-1 TO ccrtStart% STEP -1
  44.    cTabWork%(jj+1) = cTabWork%(jj)
  45. NEXT
  46. cTabWork%(ccrtStart%) = cTemp%
  47. RETURN
  48.  
  49. Fcycle:  '" Farbzyklus vorwärts (forward)
  50. cTemp% = cTabWork%(ccrtStart%)
  51. FOR jj = ccrtStart%+1 TO ccrtEnd%
  52.    cTabWork%(jj-1) = cTabWork%(jj)
  53. NEXT
  54. cTabWork%(ccrtEnd%) = cTemp%
  55. RETURN
  56.  
  57.  
  58. LoadACBM:
  59. '" - Folgende Variablen müssen 
  60. '" - initialisiert sein:
  61. REM -    ACBMname$ (ACBM-Dateiname)
  62.  
  63. REM - Variablen initialisieren
  64. f$ = acbmname$
  65. fHandle& = 0
  66. mybuf& = 0
  67. foundBMHD = 0
  68. foundCMAP = 0
  69. foundCAMG = 0
  70. foundCCRT = 0
  71. foundABIT = 0
  72.  
  73. REM - aus include/libraries/dos.h
  74. REM - MODE_NEWFILE = 1006 
  75. REM - MODE_OLDFILE = 1005
  76.  
  77. filename$ = f$ + CHR$(0)
  78. fHandle& = xOpen&(SADD(filename$),1005)
  79. IF fHandle& = 0 THEN
  80.    loadError$ = "Eingabedatei nicht gefunden/lesbar."
  81.    GOTO Lcleanup
  82. END IF
  83.  
  84.  
  85. REM - Pufferspeicherplatz reservieren
  86. ClearPublic& = 65537
  87. mybufsize& = 360
  88. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  89. IF mybuf& = 0 THEN
  90.    loadError$ = "Pufferspeicherplatz nicht verfügbar."
  91.    GOTO Lcleanup
  92. END IF
  93.  
  94. inbuf& = mybuf&
  95. cbuf& = mybuf& + 120
  96. ctab& = mybuf& + 240
  97.  
  98.  
  99. REM - Eingabe sollte lauten  FORMnnnnACBM
  100. rLen& = xRead&(fHandle&,inbuf&,12)
  101. tt$ = ""
  102. FOR kk = 8 TO 11
  103.    tt% = PEEK(inbuf& + kk)
  104.    tt$ = tt$ + CHR$(tt%)
  105. NEXT
  106.  
  107. IF tt$ <> "ACBM" THEN 
  108.    loadError$ = "Keine ACBM-Grafikdatei."
  109.    GOTO Lcleanup
  110. END IF
  111.  
  112. REM - ACBM-Datei Chunk-weise lesen
  113.  
  114. ChunkLoop:
  115. REM - Chunk-Name/Länge ermitteln
  116.  rLen& = xRead&(fHandle&,inbuf&,8)
  117.  icLen& = PEEKL(inbuf& + 4)
  118.  tt$ = ""
  119.  FOR kk = 0 TO 3
  120.     tt% = PEEK(inbuf& + kk)
  121.     tt$ = tt$ + CHR$(tt%)
  122.  NEXT   
  123.     
  124. IF tt$ = "BMHD" THEN  'BitMap-Header 
  125.    foundBMHD = 1
  126.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  127.    iWidth%  = PEEKW(inbuf&)
  128.    iHeight% = PEEKW(inbuf& + 2)
  129.    iDepth%  = PEEK(inbuf& + 8)  
  130.    iCompr%  = PEEK(inbuf& + 10)
  131.    scrWidth%  = PEEKW(inbuf& + 16)
  132.    scrHeight% = PEEKW(inbuf& + 18)
  133.  
  134.    iRowBytes% = iWidth% /8
  135.    scrRowBytes% = scrWidth% / 8
  136.    nColors%  = 2^(iDepth%)
  137.  
  138.    '" - Genug Platz für Videospeicher ?
  139.    AvailRam& = FRE(-1)
  140.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  141.    IF AvailRam& < NeededRam& THEN
  142.       loadError$ = "Speicherplatz reicht nicht aus."
  143.       GOTO Lcleanup
  144.    END IF
  145.  
  146.    kk = 1
  147.    IF scrWidth% > 320 THEN kk = kk + 1
  148.    IF scrHeight% > 200  THEN kk = kk + 2
  149.    SCREEN 2,scrWidth%,scrHeight%,5,1
  150.    WINDOW 2,"",,0,2
  151.    CALL freesprite (0)
  152.    REM - Adressen von Screen-Structures ermitteln
  153.    GOSUB GetScrAddrs
  154.  
  155.    REM - Schirm während Ladevorgang dunkel
  156.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  157.  
  158.  
  159. ELSEIF tt$ = "CMAP" THEN  'Farbpalette
  160.    foundCMAP = 1
  161.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  162.  
  163.    REM - Farbpalette aufbauen
  164.    FOR kk = 0 TO nColors% - 1
  165.       red% = PEEK(cbuf&+(kk*3))
  166.       gre% = PEEK(cbuf&+(kk*3)+1)
  167.       blu% = PEEK(cbuf&+(kk*3)+2)
  168.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  169.       POKEW(ctab&+(2*kk)),regTemp%
  170.    NEXT
  171.  
  172.  
  173. ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
  174.    foundCAMG = 1
  175.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  176.    camgModes& = PEEKL(inbuf&)
  177.  
  178.  
  179. ELSEIF tt$ = "CCRT" THEN 'Graphicraft-Farbzyklus-Daten
  180.    foundCCRT = 1
  181.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  182.    ccrtDir%    = PEEKW(inbuf&)
  183.    ccrtStart%  = PEEK(inbuf& + 2)
  184.    ccrtEnd%    = PEEK(inbuf& + 3)
  185.    ccrtSecs&   = PEEKL(inbuf& + 4)
  186.    ccrtMics&   = PEEKL(inbuf& + 8)
  187.  
  188.  
  189. ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
  190.    foundABIT = 1
  191.  
  192.    '" - Hier werden nur volle BitMaps verarbeitet, keine 
  193.    '" - Ausschnitte wie z.B. Pinsel (Brushes).
  194.    '" - Sehr schnell, liest ganze BitPlanes.
  195.    plSize& = (scrWidth%/8) * scrHeight%
  196.    FOR pp = 0 TO iDepth% -1
  197.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  198.    NEXT
  199.  
  200.  
  201. ELSE 
  202.    REM - unbekannten Chunk-Typ lesen  
  203.    FOR kk = 1 TO icLen&
  204.       rLen& = xRead&(fHandle&,inbuf&,1)
  205.    NEXT
  206.    '" - Wenn Länge ungerade, noch 1 Byte lesen
  207.    IF (icLen& OR 1) = icLen& THEN 
  208.       rLen& = xRead&(fHandle&,inbuf&,1)
  209.    END IF
  210.       
  211. END IF
  212.  
  213.  
  214. REM - Fertig, wenn alle Chunks gelesen
  215. IF foundBMHD AND foundCMAP AND foundABIT THEN
  216.    GOTO GoodLoad
  217. END IF
  218.  
  219. REM - Lesen ok, nächsten Chunk lesen
  220. IF rLen& > 0 THEN GOTO ChunkLoop
  221.  
  222. IF rLen& < 0 THEN  ' Lesefehler
  223.    loadError$ = "Lesefehler."
  224.    GOTO Lcleanup
  225. END IF   
  226.  
  227. REM - rLen& = 0  heißt EOF (Dateiende)
  228. IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
  229.    loadError$ = "Wichtige IFF-Chunks nicht gefunden."
  230.    GOTO Lcleanup
  231. END IF
  232.  
  233.  
  234. GoodLoad:
  235. loadError$ =""
  236.  
  237. REM  Farbpalette
  238. IF foundCMAP THEN 
  239.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  240. END IF
  241.  
  242. Lcleanup:
  243. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  244. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  245.  
  246. RETURN
  247.  
  248.  
  249. GetScrAddrs:
  250. REM - Adressen von Screen-Structures ermitteln
  251.    sWindow&   = WINDOW(7)
  252.    sScreen&   = PEEKL(sWindow& + 46)
  253.    sViewPort& = sScreen& + 44
  254.    sRastPort& = sScreen& + 84
  255.    sColorMap& = PEEKL(sViewPort& + 4)
  256.    colorTab&  = PEEKL(sColorMap& + 4)
  257.    sBitMap&   = PEEKL(sRastPort& + 4)
  258.  
  259.    REM - Screen-Parameter ermitteln
  260.    scrWidth%  = PEEKW(sScreen& + 12)
  261.    scrHeight% = PEEKW(sScreen& + 14)
  262.    scrDepth%  = PEEK(sBitMap& + 5)
  263.    nColors%   = 2^scrDepth%
  264.  
  265.    REM - Adressen der BitPlanes ermitteln
  266.    FOR kk = 0 TO scrDepth% - 1
  267.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  268.    NEXT
  269. RETURN
  270.  
  271.  
  272.  
  273.  
  274.  
  275. spielanfang:
  276. IF spielgewinn=1 THEN SLEEP:SYSTEM
  277. POKE &Hdff0*256+&H96,32
  278. DEFLNG a-z
  279. DECLARE FUNCTION opendiskfont&() LIBRARY
  280. LIBRARY "diskfont.library"
  281. altfont=PEEKL(WINDOW(8)+52)
  282. neufont$="amber.font"+CHR$(0)
  283. hoehe=9:pref=26 
  284. text(0)=SADD(neufont$)
  285. text(1)=(2^16)*hoehe+pref
  286. font=opendiskfont&(VARPTR(text(0)))
  287. IF font<>0 THEN CALL setfont&(WINDOW(8),font)
  288. PALETTE 17,0,0,0
  289. PALETTE 18,0,0,0
  290. PALETTE 19,0,0,0
  291. PALETTE 7,0.1,0.1,0.5
  292. PALETTE 15,0.23,0.23,0.23
  293. PALETTE 6,0.4,0,0.23
  294. PALETTE 4,0.9,0.9,0.3
  295. RANDOMIZE TIMER
  296. sklaven=100:kk=500
  297. jahre=1:anerkennung=1:pyramide=0
  298. GOSUB sharewaremitteilung
  299. GOSUB inhalt
  300.  
  301. gesamtuebersicht:
  302. jahre=jahre+1
  303. sauber
  304. LOCATE 6,6:PRINT "Sie haben:"
  305. COLOR 15,10: LOCATE 8,6:PRINT "Sklaven:":
  306. COLOR 6,10:LOCATE 8,20
  307. PRINT USING "####";sklaven
  308. COLOR 15,10:LOCATE 10,6:PRINT "Kamele:"
  309. COLOR 6,10:LOCATE 10,20
  310. PRINT USING "####";kamele
  311. COLOR 15,10:LOCATE 12,6:PRINT "Boote:"
  312. COLOR 6,10:LOCATE 12,20
  313. PRINT USING "####";boote
  314. COLOR 15,10:LOCATE 14,6:PRINT "Korn Kisten:"
  315. COLOR 6,10:LOCATE 14,20:PRINT USING "####";kk
  316. COLOR 15,10:LOCATE 16,6:PRINT "Pyramide:"
  317. LOCATE 17,6:PRINT "in %"
  318. COLOR 6,10:LOCATE 16,20:PRINT INT(pyramide)
  319. feld=0:pyramidenbau=0:steinbruch=0
  320. SLEEP:SLEEP
  321. IF anerkennung=1 AND jahre<=30 AND pyramide>=5 THEN GOTO bonusrunde
  322. IF jahre>=40 AND pyramide<=7 THEN GOTO pharaotot
  323. sauber
  324.  
  325.  
  326. arbeitereinteilung:
  327. LOCATE 6,6
  328. PRINT "Sklaven Einteilung:"
  329. COLOR 15,10
  330. LOCATE 8,6
  331. PRINT "Steinbruch:"
  332. COLOR 7,10:LOCATE 8,23:PRINT USING "####";steinbruch
  333. COLOR 15,10:LOCATE 10,6:PRINT "Feld:"
  334. COLOR 7,10:LOCATE 10,23:PRINT USING "####";feld
  335. COLOR 15,10:LOCATE 12,6:PRINT "Pyramidenbau:"
  336. COLOR 7,10:LOCATE 12,23:PRINT USING "####";pyramidenbau 
  337. COLOR 15,10:LOCATE 14,6:PRINT "Sklaven gesamt:"
  338. COLOR 7,10:LOCATE 14,23:PRINT USING "####";sklaven
  339. COLOR 13,10
  340. LOCATE 16,6:PRINT "1 -> Steinbruch"
  341. LOCATE 17,6:PRINT "2 -> Feld"
  342. LOCATE 18,6:PRINT "3 -> Pyramidenbau"
  343. LOCATE 19,6:PRINT "4 -> Weiter"
  344. arbeitereinteilungtastenabrage: 
  345.  a$=INKEY$
  346.  IF a$="1" THEN arbeitersteinbruch 
  347.  IF a$="2" THEN arbeiterfeld
  348.  IF a$="3" THEN arbeiterpyramidenbau
  349.  IF a$="4" THEN arbeiteressengeben
  350. GOTO arbeitereinteilungtastenabrage  
  351. arbeitersteinbruch:
  352.  LINE (30,130)-(270,175),10,bf
  353.  COLOR 13,10
  354.  LOCATE 17,6:PRINT "Steinbruchsklaven:"
  355.  COLOR 6,10
  356.  LOCATE 18,10:INPUT "",steinbruch
  357.  IF steinbruch+feld+pyramidenbau>sklaven THEN
  358.  LOCATE 18,10:PRINT SPACE$(5):GOTO arbeitersteinbruch 
  359.  END IF
  360.  LINE (30,130)-(270,175),10,bf
  361. GOTO arbeitereinteilung
  362. arbeiterfeld:
  363.  LINE (30,130)-(270,175),10,bf 
  364.  COLOR 13,10
  365.  LOCATE 17,6:PRINT "Feldsklaven:"
  366.  COLOR 6,10
  367.  LOCATE 18,10:INPUT "",feld
  368.  IF steinbruch+feld+pyramidenbau>sklaven THEN
  369.  LOCATE 18,10:PRINT SPACE$(5):GOTO arbeiterfeld 
  370.  END IF
  371.  LINE (30,130)-(270,175),10,bf
  372. GOTO arbeitereinteilung 
  373. arbeiterpyramidenbau:
  374.  LINE (30,130)-(270,175),10,bf 
  375.  COLOR 13,10
  376.  LOCATE 17,6:PRINT "Pyramidensklaven:"
  377.  COLOR 6,10
  378.  LOCATE 18,10:INPUT "",pyramidenbau
  379.  IF steinbruch+feld+pyramidenbau>sklaven THEN
  380.  LOCATE 18,10:PRINT SPACE$(5):GOTO arbeiterpyramidenbau
  381.  END IF
  382.  LINE (30,130)-(270,175),10,bf
  383. GOTO arbeitereinteilung 
  384.   
  385.  
  386. arbeiteressengeben:
  387. sauber
  388. LOCATE 6,6
  389. PRINT "Essens Einteilung:"
  390. COLOR 15,10
  391. LOCATE 8,6
  392. PRINT "Sie haben ";kk  
  393. LOCATE 10,6
  394. PRINT "Kisten Korn"
  395. LOCATE 12,6
  396. PRINT "Wieviel sollen die "
  397. LOCATE 14,6
  398. PRINT "Sklaven zum Essen "
  399. LOCATE 16,6
  400. PRINT "bekommen ?"
  401. sklavenversorgung:
  402. COLOR 6,10:LOCATE 18,10
  403. INPUT "",essen
  404. IF essen>kk THEN 
  405. LOCATE 18,10:PRINT SPACE$(5):GOTO sklavenversorgung
  406. END IF
  407. kk=kk-essen
  408. SLEEP:SLEEP
  409. GOTO sklavengestorben:
  410.  
  411. sklavengestorben:
  412. essentot=sklaven-essen
  413. IF essen<=sklaven THEN sklaventot=RND(1)*essentot+8
  414. IF essen>=sklaven THEN sklaventot=RND(1)*5
  415. IF sklaventot<=0 THEN sklaventot=1 
  416. IF sklaventot>=sklaven THEN sklaventot=sklaven:sklaven=0
  417. sauber
  418. LOCATE 6,6:PRINT "Slavenverluste:"
  419. COLOR 15,10:LOCATE 8,6:PRINT "Sie gaben den"
  420. LOCATE 9,6:PRINT "Sklaven :":COLOR 7,10:LOCATE 9,21:PRINT USING "#####";essen
  421. COLOR 15,10:LOCATE 10,6:PRINT "Kisten Korn"
  422. LOCATE 12,6:PRINT "An Krankheiten und"
  423. LOCATE 13,6:PRINT "Arbeit sind ihnen"
  424. LOCATE 14,6:PRINT "dieses Jahr: ":COLOR 7,10
  425. LOCATE 14,21:PRINT USING "#####";sklaventot
  426. COLOR 15,10:LOCATE 15,6:PRINT "Sklaven gestorben"
  427. sklaven=sklaven-sklaventot
  428. IF sklaven<=0 THEN sklaven=0:sklaventot=0
  429. LOCATE 17,6:PRINT "Sie haben noch:":COLOR 7,10
  430. LOCATE 17,21:PRINT USING "#####";sklaven
  431. COLOR 15,10:LOCATE 18,6:PRINT "Sklaven"
  432. SLEEP:SLEEP
  433. GOTO kostenkameleboote 
  434.  
  435. kostenkameleboote:
  436. sauber
  437. kamelfressen=kamele*2
  438. bootwartungskosten=boote*3
  439. kk=kk-(kamelfressen+bootwartungskosten)
  440. IF kk<=0 THEN bootpfaendung
  441. LOCATE 6,6
  442. PRINT "Unkosten:"
  443. COLOR 15,10
  444. LOCATE 8,6:PRINT "Die Kamele"
  445. LOCATE 9,6:PRINT "fressen:":COLOR 7,10:LOCATE 9,21
  446. PRINT USING "#####";kamelfressen
  447. COLOR 15,10:LOCATE 10,6:PRINT "Kisten Korn"
  448. LOCATE 12,6:PRINT "Die Wartung der"
  449. LOCATE 13,6:PRINT "Boote kostet:":COLOR 7,10
  450. LOCATE 13,21:PRINT USING "#####";bootwartungskosten
  451. COLOR 15,10:LOCATE 14,6:PRINT "Korn Kisten"
  452. LOCATE 16,6:PRINT "Sie haben:":COLOR 7,10:LOCATE 16,21
  453. PRINT USING "#####";kk
  454. COLOR 15,10:LOCATE 17,6:PRINT "Korn Kisten"
  455. SLEEP:SLEEP
  456. GOTO bootekamelekaufen:
  457.  
  458. bootekamelekaufen:
  459. sauber
  460. LOCATE 6,6
  461. PRINT "Markttag:"
  462. COLOR 15,10 
  463. LOCATE 8,6:PRINT "Sie haben:"
  464. COLOR 15,10: LOCATE 10,6:PRINT "Sklaven:":
  465. COLOR 7,10:LOCATE 10,20
  466. PRINT USING "####";sklaven
  467. COLOR 15,10:LOCATE 11,6:PRINT "Kamele:"
  468. COLOR 7,10:LOCATE 11,20
  469. PRINT USING "####";kamele
  470. COLOR 15,10:LOCATE 12,6:PRINT "Boote:"
  471. COLOR 7,10:LOCATE 12,20
  472. PRINT USING "####";boote
  473. COLOR 15,10:LOCATE 13,6:PRINT "Korn Kisten:"
  474. COLOR 7,10:LOCATE 13,20:PRINT USING "####";kk
  475. COLOR 13,10
  476. LOCATE 16,6:PRINT "1 -> Boote handeln"
  477. LOCATE 17,6:PRINT "2 -> Kamele handeln"
  478. LOCATE 18,6:PRINT "3 -> Sklaven handeln"
  479. LOCATE 19,6:PRINT "4 -> Weiter"
  480. bootekameletastenabfrage: 
  481.  a$=INKEY$
  482.  IF a$="1" THEN bootehandeln
  483.  IF a$="2" THEN kamelehandeln
  484.  IF a$="3" THEN sklavenhandeln
  485.  IF a$="4" THEN kornernte
  486. GOTO bootekameletastenabfrage  
  487.  
  488.  
  489. bootehandeln:
  490. IF booteanzeige=1 THEN booteanzeigen
  491. bootpreis=(kk*RND(2)+boote)
  492. IF bootpreis<=30 THEN bootpreis=50
  493. bootkaufpreis=(kk*RND(2)-kk*RND(1))
  494. IF bootkaufpreis<=30 THEN bootkaufpreis=50
  495. IF bootkaufpreis>bootpreis THEN bootehandeln
  496. booteanzeige=1
  497. booteanzeigen:
  498. sauber
  499. booteanzeigen1:
  500. LOCATE 6,6:PRINT "Boote handeln"
  501. COLOR 15,10:LOCATE 8,6
  502. PRINT "Der Makler nimmt"
  503. LOCATE 9,6:PRINT "folgende Preise:"
  504. LOCATE 11,6:PRINT "Boot kaufen: "
  505. COLOR 2,10:LOCATE 11,21:PRINT USING "####";bootpreis
  506. COLOR 15,10:LOCATE 12,6:PRINT "Boot verkaufen:"
  507. COLOR 2,10:LOCATE 12,21:PRINT USING "####";bootkaufpreis
  508. COLOR 2,10:LOCATE 14,6:PRINT "Sie haben:":COLOR 15,10
  509. LOCATE 15,6:PRINT "Boote:":COLOR 7,10
  510. LOCATE 15,21:PRINT USING "####";boote
  511. COLOR 15,10:LOCATE 16,6:PRINT "Korn Kisten:":COLOR 7,10
  512. LOCATE 16,21:PRINT USING "####";kk
  513. COLOR 13,10:LOCATE 17,6:PRINT "1 -> Boot kaufen"
  514. LOCATE 18,6:PRINT "2 -> Boot verkaufen"
  515. LOCATE 19,6:PRINT "3 -> Weiter"
  516. bootehandelntastaturabfrage:
  517. a$=INKEY$
  518. IF a$="1" THEN bootkaufen
  519. IF a$="2" THEN bootverkaufen
  520. IF a$="3" THEN bootekamelekaufen
  521. GOTO bootehandelntastaturabfrage
  522. bootkaufen:
  523. IF kk<bootpreis THEN booteanzeigen1
  524. kk=kk-bootpreis:boote=boote+1
  525. GOTO booteanzeigen1
  526. bootverkaufen:
  527. IF boote<1 THEN booteanzeigen1
  528. boote=boote-1
  529. kk=kk+bootkaufpreis
  530. GOTO booteanzeigen1
  531.  
  532. kamelehandeln:
  533. IF kameleanzeige=1 THEN kameleanzeigen
  534. kamelpreis=(100*RND(2)+kamele)
  535. IF kamelpreis<=15 THEN kamelpreis=50
  536. kamelkaufpreis=(100*RND(1)-kamele*RND(1))
  537. IF kamelkaufpreis<=15 THEN kamelkaufpreis=50
  538. IF kamelkaufpreis>kamelpreis THEN kamelehandeln
  539. kameleanzeige=1
  540. kameleanzeigen:
  541. sauber
  542. kameleanzeigen1:
  543. LOCATE 6,6:PRINT "Kamele handeln"
  544. COLOR 15,10:LOCATE 8,6
  545. PRINT "Der Makler nimmt"
  546. LOCATE 9,6:PRINT "folgende Preise:"
  547. LOCATE 11,6:PRINT "Kamel kaufen: "
  548. COLOR 2,10:LOCATE 11,23:PRINT USING "####";kamelpreis
  549. COLOR 15,10:LOCATE 12,6:PRINT "Kamel verkaufen:"
  550. COLOR 2,10:LOCATE 12,23:PRINT USING "####";kamelkaufpreis
  551. COLOR 2,10:LOCATE 14,6:PRINT "Sie haben:":COLOR 15,10
  552. LOCATE 15,6:PRINT "Kamele:":COLOR 7,10
  553. LOCATE 15,23:PRINT USING "####";kamele
  554. COLOR 15,10:LOCATE 16,6:PRINT "Korn Kisten:":COLOR 7,10
  555. LOCATE 16,23:PRINT USING "####";kk
  556. COLOR 13,10:LOCATE 17,6:PRINT "1 -> Kamel kaufen"
  557. LOCATE 18,6:PRINT "2 -> Kamel verkaufen"
  558. LOCATE 19,6:PRINT "3 -> Weiter"
  559. kamelhandelntastaturabfrage:
  560. a$=INKEY$
  561. IF a$="1" THEN kamelkaufen
  562. IF a$="2" THEN kameleverkaufen
  563. IF a$="3" THEN bootekamelekaufen
  564. GOTO kamelhandelntastaturabfrage
  565. kamelkaufen:
  566. IF kk<kamelpreis THEN kameleanzeigen1
  567. kk=kk-kamelpreis:kamele=kamele+1
  568. GOTO kameleanzeigen1
  569. kameleverkaufen:
  570. IF kamele<1 THEN kameleanzeigen1
  571. kamele=kamele-1
  572. kk=kk+kamelkaufpreis
  573. GOTO kameleanzeigen1
  574.  
  575. sklavenhandeln:
  576. IF sklavenanzeige=1 THEN sklavenanzeigen
  577. sklavenpreis=(10*RND(2)+5)
  578. IF sklavenpreis<=6 THEN sklavenpreis=6
  579. sklavenkaufpreis=(8*RND(2)+4)
  580. IF sklavenkaufpreis<=4 THEN sklavenkaufpreis=5
  581. IF sklavenkaufpreis>sklavenpreis THEN sklavenhandeln
  582. sklavenanzeige=1
  583. sklavenanzeigen:
  584. sauber
  585. sklavenanzeigen1:
  586. LOCATE 6,6:PRINT "Sklaven handeln"
  587. COLOR 15,10:LOCATE 8,6
  588. PRINT "Der Makler nimmt"
  589. LOCATE 9,6:PRINT "folgende Preise:"
  590. LOCATE 11,6:PRINT "Sklave kaufen: "
  591. COLOR 2,10:LOCATE 11,23:PRINT USING "####";sklavenpreis
  592. COLOR 15,10:LOCATE 12,6:PRINT "Sklave verkaufen:"
  593. COLOR 2,10:LOCATE 12,23:PRINT USING "####";sklavenkaufpreis
  594. COLOR 2,10:LOCATE 14,6:PRINT "Sie haben:":COLOR 15,10
  595. LOCATE 15,6:PRINT "Sklaven:":COLOR 7,10
  596. LOCATE 15,23:PRINT USING "####";sklaven
  597. COLOR 15,10:LOCATE 16,6:PRINT "Korn Kisten:":COLOR 7,10
  598. LOCATE 16,23:PRINT USING "####";kk
  599. COLOR 13,10:LOCATE 17,6:PRINT "1 -> Sklave kaufen"
  600. LOCATE 18,6:PRINT "2 -> Sklave verkaufen"
  601. LOCATE 19,6:PRINT "3 -> Weiter"
  602. sklavenhandelntastaturabfrage:
  603. a$=INKEY$
  604. IF a$="1" THEN sklavenkaufen
  605. IF a$="2" THEN sklavenverkaufen
  606. IF a$="3" THEN bootekamelekaufen
  607. GOTO sklavenhandelntastaturabfrage
  608. sklavenkaufen:
  609. IF kk<sklavenpreis THEN sklavenanzeigen1
  610. kk=kk-sklavenpreis:sklaven=sklaven+1
  611. GOTO sklavenanzeigen1
  612. sklavenverkaufen:
  613. IF sklaven<1 THEN sklavenanzeigen1
  614. sklaven=sklaven-1
  615. kk=kk+sklavenkaufpreis
  616. GOTO sklavenanzeigen1
  617.  
  618. kornernte:
  619. booteanzeige=0:kameleanzeige=0
  620. sklavenanzeige=0:sauber
  621.  RANDOMIZE TIMER
  622.   wetter=RND(1)
  623.   IF wetter<0.4 THEN ernte=INT(kk*(RND(1)*(0.4-wetter))+(RND(1)*feld))
  624.   ernte=INT(kk*(RND(1)*(wetter))+(RND(1)*feld))
  625.     IF feld=0 THEN ernte=0
  626.   IF kk=0 THEN ernte=0
  627. kk=kk+ernte
  628.  LOCATE 6,6:PRINT "Kornernte:"
  629. LOCATE 8,6:COLOR 15,10
  630. PRINT "Die Sklaven ernteten"
  631. LOCATE 10,6:PRINT "dieses Jahr:" 
  632. LOCATE 13,6
  633. PRINT "Die Ernte:"
  634. COLOR 7,10:LOCATE 13,21:PRINT USING "#####";ernte
  635. COLOR 15,10:LOCATE 15,6:PRINT "Korn Kisten:"
  636. LOCATE 16,6:PRINT "gesamt":COLOR 7,10
  637. LOCATE 15,21:PRINT USING "#####";kk
  638. SLEEP:SLEEP
  639. GOTO steinbruchanzeige
  640.  
  641. steinbruchanzeige:
  642. sauber
  643. steine=RND(1)*steinbruch
  644. steinlager=steinlager+steine
  645. LOCATE 6,6:PRINT "Steinbruch:"
  646. COLOR 15,10:LOCATE 8,6
  647. PRINT "Die Sklaven brachen"
  648. LOCATE 10,6:PRINT "dieses Jahr:"
  649. LOCATE 13,6:PRINT "Steine:"
  650. COLOR 7,10:LOCATE 13,21:PRINT USING "####";steine
  651. COLOR 15,10:LOCATE 15,6:PRINT "Steine im "
  652. LOCATE 16,6:PRINT "Lager:":COLOR 7,10
  653. LOCATE 16,21:PRINT USING "####";steinlager
  654. SLEEP:SLEEP
  655. GOTO foerderanzeige
  656.  
  657. foerderanzeige:
  658. sauber
  659. boottransport=9*boote
  660. IF boottransport>steinlager THEN boottransport=steinlager:steinlager=0:GOTO foerderanzeige1
  661. steinlager=steinlager-boottransport
  662. IF steinlager<=0 THEN kameltransport=0:GOTO foerderanzeige1
  663. kameltransport=3*kamele
  664. IF kameltransport>steinlager THEN kameltransport=steinlager:steinlager=0:GOTO foerderanzeige1
  665. steinlager=steinlager-kameltransport
  666. foerderanzeige1:
  667. LOCATE 6,6:PRINT "Transport:"
  668. COLOR 15,10:LOCATE 8,6
  669. PRINT "Steine im"
  670. LOCATE 9,6:PRINT "Lager: ":LOCATE 9,21:COLOR 7,10
  671. PRINT USING "####";steinlager
  672. COLOR 15,10:LOCATE 11,6:PRINT "Folgende Steine":LOCATE 12,6
  673. PRINT "koennen von Booten":LOCATE 13,6
  674. PRINT "und Kamelen abgeholt":LOCATE 14,6:PRINT "werden:"
  675. LOCATE 16,6:PRINT "Boote: ":LOCATE 16,21:COLOR 7,10
  676. PRINT USING "####";boottransport
  677. COLOR 15,10:LOCATE 18,6:PRINT "Kamele:":LOCATE 18,21:COLOR 7,10
  678. PRINT USING "####";kameltransport
  679. SLEEP:SLEEP
  680. GOTO pyramidenbauanzeige
  681.  
  682. pyramidenbauanzeige: 
  683. sauber
  684. IF pyramidenbau<>0 THEN verbrauchtesteine=INT(pyramidenbau/4) :ELSE verbrauchtesteine=0 
  685. pyramidensteine=pyramidensteine+kameltransport+boottransport-verbrauchtesteine
  686. IF pyramidensteine<=0 THEN verbrauchtesteine=pyramidensteine
  687. IF verbrauchtesteine>pyramidensteine THEN verbrauchtesteine=pyramidensteine
  688. rechensteine=rechensteine+verbrauchtesteine
  689. IF pyramide>99 THEN spielgewinn
  690. pyramide=rechensteine*100/1000 
  691.  
  692. LOCATE 6,6:PRINT "Pyramidenbau:"
  693. COLOR 15,10:LOCATE 8,6
  694. PRINT "Steine bei: ":LOCATE 8,23:COLOR 7,10:PRINT USING"####";pyramidensteine
  695. COLOR 15,10:LOCATE 9,6:PRINT "der Pyramide"
  696. COLOR 15,10:LOCATE 11,6:PRINT "Verbrauchte":LOCATE 12,6:PRINT "Steine:"
  697. COLOR 7,10:LOCATE 12,23:PRINT USING "####";verbrauchtesteine
  698. COLOR 15,10:LOCATE 14,6:PRINT "Pyramide fertig:":LOCATE 15,6:PRINT "in %"
  699. COLOR 7,10:LOCATE 14,23:PRINT pyramide
  700. SLEEP:SLEEP
  701. GOTO gesamtuebersicht 
  702.  
  703. bootpfaendung:
  704. IF boote=0 THEN kamelpfaendung
  705. boote=boote-1:kk=kk+bootkaufpreis
  706. IF kk=kk<=0 THEN bootpfaendung
  707. GOTO pfaendungstart
  708. kamelpfaendung:
  709. IF kamele=0 THEN GOTO pfaendungstart
  710. kamele=kamele-1:kk=kk+kamelkaufpreis
  711. IF kk<=0 THEN kamelpfaendung
  712. pfaendungstart:
  713. IF kk<=0 THEN kk=0
  714. sauber
  715. LOCATE 6,6:PRINT "Pfaendung:"
  716. COLOR 15,10
  717. LOCATE 8,6:PRINT "Um ihre Schulden" 
  718. LOCATE 10,6:PRINT "auszugleichen wurden "
  719. LOCATE 12,6:PRINT "Ihnen Boote und "
  720. LOCATE 14,6:PRINT "Kamele Gepfaendet !!!" 
  721. SLEEP:SLEEP
  722. GOTO bootekamelekaufen:
  723.  
  724. bonusrunde:
  725. sauber
  726. COLOR 15,10
  727. anerkennungssklaven=RND(1)*40
  728. anerkennung=0
  729. LOCATE 6,6:PRINT "Der Hofmeister dankt"
  730. LOCATE 7,6:PRINT "Dir fuer Deine gute "
  731. LOCATE 8,6:PRINT "Arbeit und schenkt "
  732. LOCATE 9,6:PRINT "Dir als Anerkennung:"
  733. LOCATE 11,6:PRINT "Sklaven:":LOCATE 11,21:COLOR 7,10
  734. PRINT USING "#####";anerkennungssklaven 
  735. sklaven=sklaven+anerkennungssklaven
  736. SLEEP:SLEEP
  737. sauber
  738. GOTO arbeitereinteilung
  739.  
  740. pharaotot:
  741. sauber
  742. LOCATE 6,6:PRINT "Der Pharao Cool Cat"
  743. LOCATE 7,6:PRINT "ist leider gestorben."
  744. LOCATE 8,6:PRINT "Da Sie die Pyramide "
  745. LOCATE 9,6:PRINT "noch nicht fertig "
  746. LOCATE 10,6:PRINT "haben, haben Sie "
  747. LOCATE 11,6:PRINT "jetzt keine gute "
  748. LOCATE 12,6:PRINT "Zukunft !!"
  749. LOCATE 13,6:PRINT "Leider ist ihr Leben"
  750. LOCATE 14,6:PRINT "nun zuende, und damit"
  751. LOCATE 15,6:PRINT "auch das Spiel !!"
  752. spielgewinn=1
  753. SLEEP:SLEEP:SLEEP
  754. GOTO spielanfang 
  755.  
  756.  
  757. spielgewinn:
  758. spielgewinn=1
  759. sauber
  760. LOCATE 6,6:PRINT "Der Pharao Cool Cat"
  761. LOCATE 7,6:PRINT "ist hoch erfreut "
  762. LOCATE 8,6:PRINT "ueber Ihre so gute"
  763. LOCATE 9,6:PRINT "Arbeit. Als Lohn"
  764. LOCATE 10,6:PRINT "werden Sie nun mit"
  765. LOCATE 11,6:PRINT "Gold aufgewogen."
  766. LOCATE 12,6:PRINT "Ihnen steht eine"
  767. LOCATE 13,6:PRINT "erfolgreiche Zukunft"
  768. LOCATE 14,6:PRINT "ins Haus. Sie haben"
  769. LOCATE 15,6:PRINT "ausgesorgt !!"
  770. COLOR 7,10
  771. LOCATE 17,6:PRINT "Herzlichen"
  772. LOCATE 18,7:PRINT "Glueckwunsch !!"
  773. SLEEP:SLEEP:SLEEP
  774. GOTO spielanfang 
  775.   
  776.  
  777. SUB sp(schreib$) STATIC
  778. CALL text (WINDOW(8),SADD(schreib$),LEN(schreib$))
  779. END SUB
  780.  
  781. SUB sauber STATIC
  782. FOR i=1 TO 70
  783. LINE (30+i,35+i)-(270-i,175-i),10,b
  784. REM FOR a=1 TO 200:NEXT
  785. NEXT
  786. LINE (30,130)-(270,175),10,bf
  787. COLOR 2,10
  788. END SUB
  789.  
  790. inhalt:
  791. sauber
  792. COLOR 2,10
  793. LOCATE 6,10
  794. CALL setdrmd&(WINDOW(8),0)
  795. POKE WINDOW (8)+56,2
  796. PRINT "Pyramide "
  797. POKE WINDOW (8)+56,4
  798. LOCATE 8,5:COLOR 7,10
  799. CALL sp("Sie sind der Baumeister")
  800. LOCATE 9,5
  801. CALL sp("von Pharao CoolCat.")
  802. LOCATE 10,5
  803. CALL sp("Seine Zeit ist am Ende,")
  804. LOCATE 11,5
  805. CALL sp("und Sie sollen ihm eine")
  806. LOCATE 12,5
  807. CALL sp("Pyramide bauen. Wenn")
  808. LOCATE 13,5
  809. CALL sp("Sie es schaffen, so")
  810. LOCATE 14,5
  811. CALL sp("werden Sie mit Gold ")
  812. LOCATE 15,5
  813. CALL sp("aufgewogen. Wenn Sie")
  814. LOCATE 16,5
  815. CALL sp("jedoch versagen, so")
  816. LOCATE 17,5
  817. CALL sp("dienen Sie als Futter")
  818. LOCATE 18,5
  819. CALL sp("fuer die Krokodile !!")
  820. CALL setdrmd&(WINDOW(8),1)
  821. POKE WINDOW (8)+56,0
  822. SLEEP:SLEEP
  823. RETURN 
  824.  
  825. sharewaremitteilung:
  826. COLOR 2,10
  827. LOCATE 6,6
  828. CALL setdrmd&(WINDOW(8),0)
  829. POKE WINDOW (8)+56,3
  830. PRINT "Autorenmitteilung:"
  831. POKE WINDOW (8)+56,4
  832. COLOR 15,10:LOCATE 8,6
  833. PRINT "Dieses Spiel wurde"
  834. LOCATE 9,6
  835. PRINT "programmiert von:"
  836. COLOR 4,10:LOCATE 10,7
  837. PRINT "Martin Jochimczyk"
  838. LOCATE 11,7:PRINT "Am Sande 12"
  839. POKE WINDOW (8)+56,5
  840. LOCATE 12,7:PRINT "D-2723 Scheessel"
  841. POKE WINDOW (8)+56,4
  842. COLOR 15,10
  843. LOCATE 14,6
  844. PRINT "Solange mein Name"
  845. LOCATE 15,6
  846. PRINT "im Programm bleibt"
  847. LOCATE 16,6
  848. PRINT "darf das Programm "
  849. LOCATE 17,6
  850. PRINT "weitergegeben werden"
  851. LOCATE 19,6:PRINT "Viel Spass!"
  852. SLEEP:SLEEP
  853. RETURN
  854.  
  855.